home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 10 / Amoszine 10 (Disk 3 of 3).adf / menusys.lha / SOURCE_MSYSB.AMOS / SOURCE_MSYSB.amosSourceCode
Encoding:
AMOS Source Code  |  1993-07-24  |  9.6 KB  |  487 lines
  1. FIL$=Command Line$
  2. Request Wb 
  3.  
  4. Screen Open 1,640,256,8,Hires
  5. Paper 0 : Cls : Flash Off : Curs Off 
  6. Palette 0,0,0,0,0,0,0,0
  7.  
  8. Break Off 
  9. Limit Mouse 0,0 To 640,300
  10. Screen Display 1,,40,,
  11.  
  12. Dim MNU$(90,2),MNI(90,4),ARRS(2,4),WINCON(4),PAL(8)
  13. Global MNU$(),MNI(),ARRS(),ERR,WINCON(),SFNT,VER$
  14. Global PAL(),_SYS$
  15.  
  16. VER$="5.00B"
  17.  
  18. _SYS$="SYS:"
  19. _WIN
  20. _SEARCH["Peridot.Font"]
  21.  
  22. SFNT=Param
  23. Set Font SFNT
  24. Gr Writing 0
  25.  
  26. If FIL$<>""
  27.    _LOAD[FIL$]
  28.    If Param=False
  29.       _WINDCLOSE[1]
  30.       _WINDOPEN[1,300,0,340,10,"Error: Loading Failed !!",0]
  31.       Wait 100
  32.       _WINDCLOSE[1]
  33.       Screen Close 1
  34.       End 
  35.    End If 
  36. Else 
  37.    _WINDCLOSE[1]
  38.    _WINDOPEN[1,300,0,340,10,"Error: No Filename !!",0]
  39.    Wait 100
  40.    _WINDCLOSE[1]
  41.    Screen Close 1
  42.    End 
  43. End If 
  44.  
  45. _SETDIS[20]
  46. _SCANMATRIX[20]
  47.  
  48. Procedure _SETDIS[BDOWN]
  49.    
  50.    Screen 1
  51.    
  52.    _BOX[0,240,580,9,False,2,4,3,1,"** MENU SYSTEM V"+VER$+" ** ",%11]
  53.    _BOX[585,240,45,9,False,2,4,3,1,"QUIT",%11]
  54.  
  55.    If Amos Here=False
  56.       Amos To Front 
  57.    End If 
  58.    
  59.    For _ROW=1 To BDOWN
  60.       _REDO_ROW[_ROW-1]
  61.    Next 
  62.    
  63.    Fade 3,PAL(0),PAL(1),PAL(2),PAL(3),PAL(4),PAL(5),PAL(6),PAL(7)
  64.    Wait 3*15
  65.    
  66. End Proc
  67. Procedure _BOX[X,Y,W,H,INV,CINS,CHIG,CLOW,CTEX,TEX$,TTYP]
  68.    
  69.    If CINS<>-1
  70.       Ink CINS
  71.       Bar X,Y To X+W,Y+H
  72.    End If 
  73.    
  74.    If INV=False Then Ink CLOW Else Ink CHIG
  75.    Box X,Y To X+W,Y+H
  76.    
  77.    If INV=False Then Ink CHIG Else Ink CLOW
  78.    Draw X,Y To X+W,Y
  79.    Draw X,Y To X,Y+H
  80.    
  81.    If TEX$<>""
  82.       If Btst(0,TTYP)=True
  83.          TX=Text Length(TEX$)
  84.          TX=X+((W-TX)/2)
  85.       Else 
  86.          TX=X+6
  87.       End If 
  88.       If Btst(1,TTYP)=True
  89.          Ink 0
  90.          Text TX+1,Y+8,TEX$
  91.       End If 
  92.       Ink CTEX
  93.       Text TX,Y+7,TEX$
  94.    End If 
  95.    
  96. End Proc
  97. Procedure _SCANMATRIX[SZ]
  98.    
  99.    Screen 1
  100.    
  101.    _BXWD=157
  102.    _BXHI=11
  103.    _BXXS=2
  104.    _BXYS=14
  105.    
  106.    _MXY=_BXYS+(SZ*_BXHI)
  107.    _MXX=_BXXS+(4*_BXWD)
  108.    
  109.    _PARRAY[2,0,0,0,0,0]
  110.    _PARRAY[1,1,585,240,45,9] : Rem QUIT 
  111.    
  112.    Repeat 
  113.       Repeat 
  114.          MCOND=Mouse Key
  115.          If MCOND>0
  116.             
  117.             BT=-1
  118.             
  119.             MX=X Screen(X Mouse)
  120.             MY=Y Screen(Y Mouse)
  121.             
  122.             If MX>_BXXS and MX<_MXX
  123.                X=MX-_BXXS
  124.                If MY>_BXYS and MY<_MXY
  125.                   
  126.                   Y=MY-_BXYS
  127.                   
  128.                   _ROW=Int(Y/_BXHI)
  129.                   _COL=Int(X/_BXWD)
  130.                   BT=(_ROW*4)+_COL
  131.                   
  132.                   Rem If The Area Activated Is Part Of Another Button Then The Locates 
  133.                   Rem The Start Position Of The Button And Sets The Position Vector
  134.                   Rem To Point To The Start
  135.                   
  136.                   If MNI(BT,2)=-1
  137.                      _PCOL=_COL
  138.                      FOUND=False
  139.                      Repeat 
  140.                         Dec _PCOL
  141.                         If MNI((_ROW*4)+_PCOL,2)>-1
  142.                            FOUND=True
  143.                         End If 
  144.                      Until _PCOL=0 or FOUND=True
  145.                      _COL=_PCOL
  146.                      BT=(_ROW*4)+_COL
  147.                   End If 
  148.                   
  149.                   Rem Invert The Button If TYPE [MNI(BT,1)] Is Less Than 3 
  150.                   
  151.                   If MNI(BT,1)<4
  152.                      _INVERT_BUTTON[_ROW,_COL,BT]
  153.                   End If 
  154.                   
  155.                End If 
  156.             End If 
  157.          End If 
  158.          
  159.          If BT=-1
  160.             If MY>240 and MY<249
  161.                _EDITING_CONTROL[MX,MY]
  162.             End If 
  163.          End If 
  164.          
  165.          If MCOND=1 and BT>-1
  166.             If MNU$(BT,2)<>""
  167.                If MNI(BT,1)<3
  168.                   _EXECUTE[BT]
  169.                Else 
  170.                   If MNI(BT,1)=3
  171.                      If Exist(MNU$(BT,2))=True
  172.                         Fade 3,0,0,0,0,0,0,0,0
  173.                         Wait 3*15
  174.                         _LOAD[MNU$(BT,2)]
  175.                         _SETDIS[20]
  176.                      End If 
  177.                   End If 
  178.                End If 
  179.             End If 
  180.          End If 
  181.          
  182.          
  183.       Until BT>0
  184.       
  185.    Until False
  186.    
  187. End Proc
  188. Procedure _SCAN[X,Y]
  189.    
  190.    _FOUND=False
  191.    _FPOINT=0
  192.    _POINT=1
  193.    _NA=ARRS(0,0)
  194.    
  195.    Repeat 
  196.       
  197.       If ARRS(_POINT,0)=1
  198.          If X>ARRS(_POINT,1)
  199.             If Y>ARRS(_POINT,2)
  200.                If X<(ARRS(_POINT,1)+ARRS(_POINT,3))
  201.                   If Y<(ARRS(_POINT,2)+ARRS(_POINT,4))
  202.                      _FOUND=True
  203.                      _FPOINT=_POINT
  204.                   End If 
  205.                End If 
  206.             End If 
  207.          End If 
  208.       End If 
  209.       
  210.       If _FOUND=False
  211.          Inc _POINT
  212.       End If 
  213.       
  214.    Until _POINT=_NA or _FOUND=True
  215.    
  216. End Proc[_FPOINT]
  217. Procedure _PARRAY[O,ZNID,X,Y,W,H]
  218.    
  219.    ARRS(ZNID,0)=O
  220.    ARRS(ZNID,1)=X
  221.    ARRS(ZNID,2)=Y
  222.    ARRS(ZNID,3)=W
  223.    ARRS(ZNID,4)=H
  224.    
  225. End Proc
  226. Procedure _WINDOPEN[N,X,Y,XX,YY,NAME$,CL]
  227.  
  228.    X$=Str$(X)-" "
  229.    Y$=Str$(Y)-" "
  230.    XX$=Str$(XX)-" "
  231.    YY$=Str$(YY)-" "
  232.    CON$="CON:"+X$+"/"+Y$+"/"+XX$+"/"+YY$+"/"+NAME$
  233.    If CL=1
  234.       CON$=CON$+"/CLOSE"
  235.    End If 
  236.    CON$=CON$+Chr$(0)
  237.  
  238.    Dreg(1)=Varptr(CON$)
  239.    Dreg(2)=1005
  240.    WINCON(N)=Doscall(-30)
  241.  
  242.    If WINCON(N)=0
  243.       ERR=Doscall(-132)
  244.    End If 
  245.    
  246. End Proc
  247. Procedure _WINDEXECUTE[N,COM$]
  248.  
  249.    If WINCON(N)=0 Then Goto ERR
  250.  
  251.    COM$=COM$+Chr$(0)
  252.    Dreg(1)=Varptr(COM$)
  253.    Dreg(2)=0
  254.    Dreg(3)=WINCON(N)
  255.    X=Doscall(-222)
  256.    If X=0
  257.       Goto ERR
  258.    End If 
  259.    
  260.    Pop Proc
  261.  
  262.    ERR:
  263.    ERR=Doscall(-132)
  264.    
  265. End Proc
  266. Procedure _WINDCLOSE[N]
  267.    
  268.    If WINCON(N)=0 Then Goto ERR
  269.  
  270.    Dreg(1)=WINCON(N)
  271.    X=Doscall(-36)
  272.    If X=0
  273.       Goto ERR
  274.    End If 
  275.    Pop Proc
  276.  
  277.    ERR:
  278.    ERR=Doscall(-132)
  279.  
  280. End Proc
  281. Procedure _WIN
  282.    
  283.    If Exist("SYS:Fonts/Peridot.Font")=True
  284.       _WINDOPEN[1,400,0,240,10,"Menu System V"+VER$+"",0]
  285.    Else 
  286.       Screen Close 1
  287.       End 
  288.    End If 
  289.    
  290. End Proc
  291. Procedure _SEARCH[_FNT$]
  292.    
  293.    Get Disc Fonts 
  294.    N=1
  295.    _FNT$=Upper$(_FNT$)
  296.    Repeat 
  297.       F$=Mid$(Upper$(Font$(N)),1,Len(_FNT$))
  298.       If F$<>_FNT$
  299.          Inc N
  300.       End If 
  301.    Until F$=_FNT$
  302.    
  303. End Proc[N]
  304. Procedure _INVERT_BUTTON[_ROW,_COL,BUT]
  305.    
  306.    SZ=153+(MNI(BUT,2)*157)
  307.    
  308.    If MNI(BUT,4)=0
  309.       CHIGH=7 : CLOW=6
  310.    Else 
  311.       CHIGH=4 : CLOW=3
  312.    End If 
  313.    
  314.    _BOX[2+(_COL*157),14+(_ROW*11),SZ,9,True,True,CHIGH,CLOW,1,"",0]
  315.    Repeat 
  316.    Until Mouse Key=0
  317.    _BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,True,CHIGH,CLOW,1,"",0]
  318.    
  319. End Proc
  320. Procedure _GENERATE_BUTTON[_ROW,_COL,BUT,TYPE]
  321.    
  322.    SZ=153+(MNI(BUT,2)*157)
  323.    
  324.    If MNI(BUT,1)<5
  325.       If TYPE=0
  326.          _BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,5,7,6,1,MNU$(BUT,1),%11]
  327.       End If 
  328.       
  329.       If TYPE=1
  330.          _BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,2,4,3,1,MNU$(BUT,1),%11]
  331.       End If 
  332.    Else 
  333.       Ink 0
  334.       Bar 2+(_COL*157),14+(_ROW*11) To 2+(_COL*157)+SZ,23+(_ROW*11)
  335.       If MNU$(BUT,1)>""
  336.          _BOX[2+(_COL*157),14+(_ROW*11),SZ,9,False,True,0,0,1,MNU$(BUT,1),%11]
  337.       End If 
  338.    End If 
  339.    
  340.    
  341. End Proc
  342. Procedure _EDITING_CONTROL[MX,MY]
  343.    
  344.    _SCAN[MX,MY]
  345.    
  346.    ZN=Param
  347.  
  348.    If ZN=1
  349.       _BOX[585,240,45,9,True,True,4,3,1,"",0]
  350.       Repeat 
  351.       Until Mouse Key=0
  352.       _BOX[585,240,45,9,False,True,4,3,1,"",0]
  353.       
  354.       Fade 2,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
  355.       Wait 2*30
  356.       Fade 3,0,0,0,0,0,0,0,0
  357.       Wait 3*30
  358.       Amos To Back 
  359.       Wait 20
  360.       _WINDCLOSE[1]
  361.       Screen Close 1
  362.       End 
  363.    End If 
  364.    
  365. End Proc
  366. Procedure _EXECUTE[BUT]
  367.    
  368.    If MNI(BUT,0)=0
  369.       Fade 2,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
  370.       Wait 2*30
  371.       Fade 3,0,0,0,0,0,0,0,0
  372.       Wait 3*30
  373.       Amos To Back 
  374.    End If 
  375.    
  376.    FL$=MNU$(BUT,2)
  377.    
  378.    MEM_PRES=Chip Free+Fast Free
  379.    
  380.    If Exist(FL$)=True
  381.       If MNI(BUT,1)=0
  382.          _WINDEXECUTE[1,_SYS$+"C/Run <Nil: >Nil: "+FL$+" "+MNU$(BUT,0)]
  383.       Else 
  384.          If MNI(BUT,1)=1
  385.             _WINDEXECUTE[1,_SYS$+"C/Execute "+FL$+" "+MNU$(BUT,0)]
  386.          Else 
  387.             If MNI(BUT,1)=2
  388.                _WINDEXECUTE[1,FL$+" "+MNU$(BUT,0)]
  389.             End If 
  390.          End If 
  391.       End If 
  392.    End If 
  393.    
  394.    If MNI(BUT,0)=0
  395.       Wait 20
  396.       _WINDCLOSE[1]
  397.       Screen Close 1
  398.       End 
  399.    Else 
  400.       If MNI(BUT,3)=1
  401.          
  402.          Repeat 
  403.             MEM_NOW=Chip Free+Fast Free
  404.             Multi Wait 
  405.          Until MEM_NOW<MEM_PRES
  406.          
  407.          _WINDCLOSE[1]
  408.          _WINDOPEN[1,300,0,340,10,"LEFT AMIGA + A - Return To Menu",0]
  409.          
  410.          Fade 3,0,0,0,0,0,0,0,0
  411.          Wait 3*30
  412.          Amos To Back 
  413.  
  414.          Repeat 
  415.             Multi Wait 
  416.             _FL=Amos Here
  417.          Until _FL=True
  418.          
  419.          Amos To Front 
  420.          Fade 3,PAL(0),PAL(1),PAL(2),PAL(3),PAL(4),PAL(5),PAL(6),PAL(7)
  421.          Wait 3*30
  422.          
  423.          _WINDCLOSE[1]
  424.          _WINDOPEN[1,400,0,240,10,"Menu System V"+VER$+"",0]
  425.          
  426.       End If 
  427.    End If 
  428.    
  429. End Proc
  430. Procedure _REDO_ROW[_ROW]
  431.    
  432.    _COL=0
  433.    Ink 0
  434.    Bar 2,14+(_ROW*11) To 626,23+(_ROW*11)
  435.    BN=_ROW*4
  436.    
  437.    Repeat 
  438.       BUT=BN+_COL
  439.       If MNI(BUT,2)>-1
  440.          _GENERATE_BUTTON[_ROW,_COL,BUT,MNI(BUT,4)]
  441.       End If 
  442.       Inc _COL
  443.    Until _COL=4
  444.    
  445. End Proc
  446. Procedure _LOAD[FIL$]
  447.    
  448.    If Exist(FIL$)=True
  449.       
  450.       _CRIPT$="ABCDEFGHIJLKLMNOPQRSTUVWXYXZ"
  451.       
  452.       _FOUND=True
  453.       Open In 1,FIL$
  454.       
  455.       Input #1,VS$
  456.  
  457.       If VS$="5.00"
  458.  
  459.          Input #1,_SYS$
  460.          For CL=0 To 7
  461.             Input #1,PAL(CL)
  462.          Next 
  463.          
  464.          For I=0 To 4
  465.             Input #1,_STR$
  466.             For N=0 To 90
  467.                CHAR$=Mid$(_STR$,N+1,1)
  468.                MNI(N,I)=Instr(_CRIPT$,CHAR$)-2
  469.             Next 
  470.          Next 
  471.          
  472.          For I=0 To 2
  473.             For N=0 To 90
  474.                Line Input #1,MNU$(N,I)
  475.             Next 
  476.          Next 
  477.  
  478.       Else 
  479.          _FOUND=False
  480.       End If 
  481.  
  482.       Close 1
  483.    Else 
  484.       _FOUND=False
  485.    End If 
  486.    
  487. End Proc[_FOUND]